home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch6 / BinCont3.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-25  |  6.4 KB  |  202 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmBinCont3 
  4.    Caption         =   "BinCont3 []"
  5.    ClientHeight    =   2910
  6.    ClientLeft      =   165
  7.    ClientTop       =   735
  8.    ClientWidth     =   5160
  9.    LinkTopic       =   "Form2"
  10.    ScaleHeight     =   2910
  11.    ScaleWidth      =   5160
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin MSComDlg.CommonDialog dlgOpenFile 
  14.       Left            =   0
  15.       Top             =   840
  16.       _ExtentX        =   847
  17.       _ExtentY        =   847
  18.       _Version        =   393216
  19.    End
  20.    Begin VB.PictureBox picOriginal 
  21.       AutoSize        =   -1  'True
  22.       Height          =   2775
  23.       Left            =   120
  24.       ScaleHeight     =   181
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   157
  27.       TabIndex        =   1
  28.       Top             =   0
  29.       Width           =   2415
  30.    End
  31.    Begin VB.PictureBox picResult 
  32.       Height          =   2775
  33.       Left            =   2640
  34.       ScaleHeight     =   181
  35.       ScaleMode       =   3  'Pixel
  36.       ScaleWidth      =   157
  37.       TabIndex        =   0
  38.       Top             =   0
  39.       Width           =   2415
  40.    End
  41.    Begin VB.Menu mnuFile 
  42.       Caption         =   "&File"
  43.       Begin VB.Menu mnuFileOpen 
  44.          Caption         =   "&Open..."
  45.          Shortcut        =   ^O
  46.       End
  47.       Begin VB.Menu mnuFileSaveAs 
  48.          Caption         =   "Save &As..."
  49.          Shortcut        =   ^A
  50.       End
  51.    End
  52. Attribute VB_Name = "frmBinCont3"
  53. Attribute VB_GlobalNameSpace = False
  54. Attribute VB_Creatable = False
  55. Attribute VB_PredeclaredId = True
  56. Attribute VB_Exposed = False
  57. Option Explicit
  58. ' Arrange the controls.
  59. Private Sub ArrangeControls()
  60.     ' Position the result PictureBox.
  61.     picResult.Move _
  62.         picOriginal.Left + picOriginal.Width + 120, _
  63.         picOriginal.Top, _
  64.         picOriginal.Width, _
  65.         picOriginal.Height
  66.     picResult.Cls
  67.     ' This makes the image resize itself to
  68.     ' fit the picture.
  69.     picResult.Picture = picResult.Image
  70.     ' Make the form big enough.
  71.     Width = picResult.Left + picResult.Width + _
  72.         Width - ScaleWidth + 120
  73.     Height = picResult.Top + picResult.Height + _
  74.         Height - ScaleHeight + 120
  75.     DoEvents
  76. End Sub
  77. ' Transform the image.
  78. Private Sub TransformImage()
  79. Dim pixels() As RGBTriplet
  80. Dim bits_per_pixel As Integer
  81. Dim brightness As Integer
  82. Dim X As Integer
  83. Dim Y As Integer
  84.     ' Get the pixels from picOriginal.
  85.     GetBitmapPixels picOriginal, pixels, bits_per_pixel
  86.     ' Set the pixel color values.
  87.     For Y = 0 To picOriginal.ScaleHeight - 1
  88.         For X = 0 To picOriginal.ScaleWidth - 1
  89.             With pixels(X, Y)
  90.                 If .rgbBlue > .rgbGreen + 5 And _
  91.                    .rgbBlue > .rgbRed + 5 _
  92.                 Then
  93.                     .rgbRed = 0
  94.                     .rgbGreen = 0
  95.                     .rgbBlue = 0
  96.                 Else
  97.                     .rgbRed = 255
  98.                     .rgbGreen = 255
  99.                     .rgbBlue = 255
  100.                 End If
  101.             End With
  102.         Next X
  103.     Next Y
  104.     ' Set picResult's pixels.
  105.     SetBitmapPixels picResult, bits_per_pixel, pixels
  106.     picResult.Picture = picResult.Image
  107. End Sub
  108. ' Start in the current directory.
  109. Private Sub Form_Load()
  110.     picOriginal.AutoSize = True
  111.     picOriginal.ScaleMode = vbPixels
  112.     picOriginal.AutoRedraw = True
  113.     picResult.ScaleMode = vbPixels
  114.     picResult.AutoRedraw = True
  115.     dlgOpenFile.CancelError = True
  116.     dlgOpenFile.InitDir = App.Path
  117.     dlgOpenFile.Filter = _
  118.         "Bitmaps (*.bmp)|*.bmp|" & _
  119.         "GIFs (*.gif)|*.gif|" & _
  120.         "JPEGs (*.jpg)|*.jpg;*.jpeg|" & _
  121.         "Icons (*.ico)|*.ico|" & _
  122.         "Cursors (*.cur)|*.cur|" & _
  123.         "Run-Length Encoded (*.rle)|*.rle|" & _
  124.         "Metafiles (*.wmf)|*.wmf|" & _
  125.         "Enhanced Metafiles (*.emf)|*.emf|" & _
  126.         "Graphic Files|*.bmp;*.gif;*.jpg;*.jpeg;*.ico;*.cur;*.rle;*.wmf;*.emf|" & _
  127.         "All Files (*.*)|*.*"
  128. End Sub
  129. ' Load the indicated file.
  130. Private Sub mnuFileOpen_Click()
  131. Dim file_name As String
  132.     ' Let the user select a file.
  133.     On Error Resume Next
  134.     dlgOpenFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  135.     dlgOpenFile.ShowOpen
  136.     If Err.Number = cdlCancel Then
  137.         Exit Sub
  138.     ElseIf Err.Number <> 0 Then
  139.         Beep
  140.         MsgBox "Error selecting file.", , vbExclamation
  141.         Exit Sub
  142.     End If
  143.     On Error GoTo 0
  144.     Screen.MousePointer = vbHourglass
  145.     DoEvents
  146.     file_name = Trim$(dlgOpenFile.FileName)
  147.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  148.         - Len(dlgOpenFile.FileTitle) - 1)
  149.     Caption = "BinCont3 [" & dlgOpenFile.FileTitle & "]"
  150.     ' Open the original file.
  151.     On Error GoTo LoadError
  152.     picOriginal.Picture = LoadPicture(file_name)
  153.     On Error GoTo 0
  154.     ' Make picResult the same size and position it.
  155.     ArrangeControls
  156.     ' Make picResult show the same image.
  157.     picResult.Picture = picOriginal.Picture
  158.     DoEvents
  159.     ' Perform the enhancement.
  160.     TransformImage
  161.     Screen.MousePointer = vbDefault
  162.     Exit Sub
  163. LoadError:
  164.     Screen.MousePointer = vbDefault
  165.     MsgBox "Error " & Format$(Err.Number) & _
  166.         " opening file '" & file_name & "'" & vbCrLf & _
  167.         Err.Description
  168. End Sub
  169. ' Save the transformed image.
  170. Private Sub mnuFileSaveAs_Click()
  171. Dim file_name As String
  172.     ' Let the user select a file.
  173.     On Error Resume Next
  174.     dlgOpenFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  175.     dlgOpenFile.ShowSave
  176.     If Err.Number = cdlCancel Then
  177.         Exit Sub
  178.     ElseIf Err.Number <> 0 Then
  179.         Beep
  180.         MsgBox "Error selecting file.", , vbExclamation
  181.         Exit Sub
  182.     End If
  183.     On Error GoTo 0
  184.     Screen.MousePointer = vbHourglass
  185.     DoEvents
  186.     file_name = Trim$(dlgOpenFile.FileName)
  187.     dlgOpenFile.InitDir = Left$(file_name, Len(file_name) _
  188.         - Len(dlgOpenFile.FileTitle) - 1)
  189.     Caption = "BinCont3 [" & dlgOpenFile.FileTitle & "]"
  190.     ' Save the transformed image into the file.
  191.     On Error GoTo SaveError
  192.     SavePicture picResult.Picture, file_name
  193.     On Error GoTo 0
  194.     Screen.MousePointer = vbDefault
  195.     Exit Sub
  196. SaveError:
  197.     Screen.MousePointer = vbDefault
  198.     MsgBox "Error " & Format$(Err.Number) & _
  199.         " saving file '" & file_name & "'" & vbCrLf & _
  200.         Err.Description
  201. End Sub
  202.